perm filename SMPLS.FOR[M11,LCS] blob
sn#461033 filedate 1979-07-21 generic text, type T, neo UTF8
00100 C***** SMPLS.F4 (CALLED 'WAVES' AT IRCAM)**************
00200 C DISPLAYS SAMPLES (WAVES) OF .DAT FILES PRODUCED BY PASS3, MUSIC5.
00300
00400 DIMENSION I(512),ILI(1),L(131)
00500 CXX DOUBLE PRECISION NM,NMX,NMZ,ITST,NBLA
00600 INTEGER*4 NM,NMX,NMZ,ITST,NBLA
00700 EQUIVALENCE (I1,I),(I2,I(2)),(I3,I(3)),(AMP,MAXAMP)
00800 DATA NBLA/' '/,IBLA/' '/,IAST/'*'/,ITST/'TEST'/
00900 DATA IFF/'F'/,NMX/' '/
01000 1212 IDEV=5
01100 C***** 5=TTY, 1=DSK
01200 LCNT=20
01300 LEND=130
01400 KOLD=130
01500 C JUNPAC IS FOR OTHER THAN 12-BIT SMPLS. NOT USED YET.
01600 JUNPAC=0
01700 JNCX=0
01800 KCNT=0
01900 ICNT=0
02000 TYPE 30
02100 ACCEPT 31,NM
02200 CC IF(NM.EQ.NBLA)NM=NMX
02300 IF(NM.EQ.NBLA)NM=ITST
02400 NMX=NM
02500 CC4000 IF(NM.EQ.NMZ)NM=ITST
02600 CPDP10 CALL IFILE(21,NM)
02700 CALL OPEN(21,NM,0,'RDO',,,'UNF')
02800 C//// KBIT=3
02900 C//// IAMP=131000
03000 C//// DUR=ISMPLS/DUR
03100 C**** NEXT 2 FOR PDP11 VERSION (12BIT ONLY NOW)
03200 IAMP=2080
03300 JAMP=51
03400 ISMPLS=32000
03500
03600 K40=40
03700 IFLIP=0
03800 NCH=1
03900 IF(NCHNS.LT.2)GO TO 33
04000 TYPE 34
04100 34 FORMAT(' TYPE CHNL NUM. '$)
04200 IFLIP=-1
04300 ACCEPT 1,NCH
04400 IF(NCH.EQ.0)NCH=1
04500 IF(NCH.NE.1)IFLIP=-IFLIP
04600 33 TYPE 47
04700 ACCEPT 46,INCX
04800 IF(INCX.EQ.0)INCX=1
04900 TYPE 40
05000 F=0
05100 ACCEPT 46,ISKP,LAST,NORM
05200 C***************************************************************
05300 C************* YOU MUST PUT COMMAS BETWEEN INPUT NUMBERS *******
05400 C***************************************************************
05500 IF(LAST.EQ.0)LAST = ISKP+100
05600 C IF NO NUMBER IS TYPED FOR 'LAST' ISKP+100 SAMPLES ARE DISPLAYED.
05700 IF(LAST.LT.ISKP)LAST=ISKP+LAST
05800 IF(LAST.GT.ISMPLS)LAST=ISMPLS
05900 IF(ISKP.NE.0)ISKP=ISKP-1
06000 50 FORMAT(' <CR>=DPY F=TO A FILE '$)
06100 51 FORMAT(' <CR>=LPT FORMAT D=DPY FORMAT '$)
06200 TYPE 50
06300 ACCEPT 31,IDSK
06400 IF(IDSK.NE.IFF)GO TO 45
06500 TYPE 51
06600 ACCEPT 31,IFL
06700 CPDP10 CALL OFILE(1,'SMPLS')
06800 CALL OPEN(1,'SMPLS',0,'NEW')
06900 CC IF(IDSK.NE.IFF)GO TO 144
07000 LCNT=50
07100 TYPE 44
07200 CC44 FORMAT(/' WRITING FILE: SMPLS.DAT',/,
07300 44 FORMAT(/' WRITING FILE: SMPLS.DAT',/)
07400 CC 1 ' TO STOP: TYPE <CALL>, F <CR>')
07500 144 IDEV=1
07600 C** FOR DSK OUTPUT.
07700 40 FORMAT(' TYPE SAMPLE NUM.1, NUM2 '$)
07800 1 FORMAT(8I9)
07900 46 FORMAT(8I)
08000 31 FORMAT(2A4)
08100 30 FORMAT(' TYPE FILE NAME '$)
08200 5 FORMAT(1X80A1)
08300 CC JAMP=51
08400 CC IF(JUNPAC.NE.0)JAMP=1637
08500 45 IF(IFL.NE.IBLA)GO TO 2
08600 CC45 IF(IFL.NE.IBLA)GO TO 102
08700 JAMP=32
08800 CC IF(JUNPAC.NE.0)JAMP=1007
08900 K40=65
09000 GO TO 2
09100 CC102 IF(JUNPAC.NE.0)GO TO 2
09200 CC202 IF(MAXAMP.GT.1900)GO TO 2
09300 C//// IF(K.NE.'N')GO TO 2
09400 C//// JAMP=IAMP/40
09500 C//// DO 3 K=1,1024
09600 2 READ(21)I
09700 DO 3 JJ=1,512
09800
09900 IFLIP=-IFLIP
10000 ICNT=ICNT+1
10100 IF(ICNT.LT.ISKP)GO TO 3
10200 IF(ICNT.GT.LAST)GO TO 41
10300 IF(IFLIP)GO TO 3
10400 C****** STEREO FLIP-FLOP
10500 JNCX=JNCX+1
10600 IF(JNCX.NE.INCX)GO TO 3
10700 JNCX=0
10800 99 KX=I(JJ)
10900 KK=(KX+IAMP)/JAMP
11000 KF=-1
11100 KZZ=6
11200 CC IF(MOD(ICNT,100).NE.0)GO TO 997
11300 KCNT=KCNT+1
11400 IF(KCNT.LT.LCNT)GO TO 997
11500 KCNT=0
11600 KF=0
11700 KZZ=14
11800 997 IF(KOLD.EQ.KK)GO TO 777
11900 K80=KOLD
12000 IF(KK.GT.KOLD)K80=KK
12100 IF(KK.GE.LEND)LEND=K40
12200 DO 4 KM=6,LEND
12300 4 L(KM)=IBLA
12400 400 LEND=KK
12500 INC=-1
12600 IF(KK.GE.K40)INC=-INC
12700 DO 999 KZ=K40,KK,INC
12800 999 L(KZ)=IAST
12900 998 KZ=KK
13000 KOLD=KK
13100 IF (KZ.GE.K40)GO TO 777
13200 KZ=K40
13300 777 IF(KF)GO TO 7
13400 WRITE(IDEV,106)NMX,ICNT,(L(NN),NN=11,KZ)
13500 IF(IDEV.EQ.1)TYPE 106,NMX,ICNT
13600 C***TELL HOW FAR ALONG WE ARE.
13700 GO TO 3
13800 CC7 IF(JUNPAC.NE.0)GO TO 778
13900 7 WRITE(IDEV,1105)KX,(L(NN),NN=6,KZ)
14000 GO TO 3
14100 778 WRITE(IDEV,105)KX,(L(NN),NN=9,KZ)
14200 3 CONTINUE
14300 GO TO 2
14400 CXX41 CALL CLOSE(21)
14500 CPDP10 41 IF(IDEV.EQ.1)END FILE(1)
14600 41 GO TO 1212
14700 47 FORMAT(' INCREMENT = '$)
14800 105 FORMAT(I9,122A1)
14900 1105 FORMAT(I6,124A1)
15000 106 FORMAT(1XA4,I6,120A1)
15100 END